perm filename SYSLOA.LSP[SCH,LSP] blob
sn#688848 filedate 1982-11-14 generic text, type C, neo UTF8
COMMENT ā VALID 00003 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 (setq ibase 10. base 10.)
C00004 00003 )
C00008 ENDMK
Cā;
(setq ibase 10. base 10.)
(or (boundp 'load-version-alist)
;; set this variable before loading SYSLOADER to
;; cause the loading of specific versions of the modules
;; otherwise the newest versions of the FASL's will be
;; loaded.
(setq load-version-alist ()))
;; this next statement is for dumping in an old lisp.
(progn
(or (boundp 'file-exit-functions)
(setq file-exit-functions ()))
(defun file-exit-functions-check ()
(cond ((null file-exit-functions))
((y? "There are file-exit-functions. Run them?")
(mapc '(lambda (x) (funcall x ()))
(prog1 file-exit-functions
(setq file-exit-functions ()))))))
(defun y? (message)
(do ((c))
(nil)
(cursorpos 'a tyo)
(princ message)
(setq c (readch tyi))
(cond ((eq c '/
)
(cursorpos 'c tyo))
((member c '(/y /Y))
(princ "es." tyo)
(return t))
((member c '(/n /N))
(princ "o." tyo)
(return nil))
(t
(princ " please reply Y or N." tyo)))))
)
(defun load-version n
(do ((module (arg 1))
(fname (cond ((= n 1) (arg 1)) (t (mergef (arg 2) (arg 1))))))
('once
(cond ((not (get module 'version))
(setq fname (mergef fname "<ls.scheme>"))
(setq fname
(mergef fname
(list '(* *)
'* 'fasl
(or (cdr (assq module
load-version-alist))
"0"))))
(print (list 'loading fname '= (probef fname)) msgfiles)
(load fname)
(file-exit-functions-check)
)))))
(cond ((alphalessp (status lispv) '|2035|)
(do ((*pure t))
(t
(load-version 'turd))))
(t
;;; (defprop lisp (* |maclisp.new|) ppn) nmaclisp is new.
))
;; this GC-overflow setting will be overwritten when Scheme does
;; its SETUP.
(defun gc-overflow-for-loading (space)
(terpri msgfiles)
(princ ";allocating " msgfiles)
(princ space msgfiles)
(princ " space." msgfiles)
(terpri msgfiles)
'(t))
(setq gc-overflow 'gc-overflow-for-loading)
;; Static properties.
(setq putprop (append '
(FORMAT-CTL-ONE-ARG
FORMAT-CTL-MULTI-ARG FORMAT-CTL-NO-ARG
FORMAT-CTL-REPEAT-CHAR
DEFSTRUCT-DESCRIPTION
DEFSTRUCT-NAME GRUBOUT-TTY-OP
DEFSTRUCT-SLOT FETCH ASSIGN SAVE RESTORE
GET-STATE SET-STATE RACK-NUMBER RACK-TYPE
GRINDMACRO SYNTAX-PROCESSOR PROCEDURE-CLASS
VERSION EXPRESSION-CLASS UNSYNTAX-PROCESSOR
MACROEXPANDED MACRO AUTOLOAD)
putprop))
(do ((*pure t))
(t
;;(load-version 'debug '((lisp)))
(load-version 'format '((lisp)))
(load-version 'scheme 'newsys)
(load-version 'grub 'gjc-reader)
(remprop grubout-tty-plist 5.)
(load-version 'schedit)
(load-version 'gcdemn '((lisp)))
(load-version 'sysdebug)
(file-exit-functions-check)))
(setq monitor-continue-string "")
(setq *editor-job-name* 'emacs)